In this script we will look at some interactive plots showing the effect of sex on the face across populations. Remember to open the file in chrome.

Preliminaries

We will load the necessary libraries, and datasets

library(tidyr)
library(dplyr)
library(ggplot2)
source("Distances.R")
source("PlotFaces.R")

setwd('..')
path <- getwd()
setwd(paste(path, "/Results/MergedData", sep = ""))
load("MergedDat.RData")
setwd(paste(path, "/Results/FacePCA", sep = ""))
eigenvec <- read.csv("eigenvectors.csv", header=F)
eigenval <- read.csv("eigenvalues.csv", header=F)
means    <- read.csv("means.csv", header=F)
facets   <- read.csv("facets.csv", header=F)
setwd(paste(path, "/Results/FSD", sep = ""))
vectors <- read.csv("popvectors.csv")

Face plots

In this section we will see the interactive plots showing facial sexual dimorphism. To do that we need to transform the PCA vectors to the shape coordinates. Each vector (total, allometric and non-allometric) is multiplied by a constant to exaggerate the facial effects (in this case 2 and -2), multiplied by the matrix of eigenvectors, and then added the means for each landmark.

sex  <- c(rep("Male", 18), rep("Female", 18))
cols <- paste(colnames(vectors), sex, sep = ".")
fsdcoords <- as.data.frame(matrix(0, ncol = length(cols), nrow = nrow(means)))
colnames(fsdcoords) <- cols

fsdcoords[,c(1:18)] <- as.data.frame(apply(as.data.frame( t(as.matrix(vectors * -2)) %*% t(as.matrix(eigenvec)) ), 1, 
                              function(x) x + means))
fsdcoords[,c(19:36)] <- as.data.frame(apply(as.data.frame( t(as.matrix(vectors * 2)) %*% t(as.matrix(eigenvec)) ), 1, 
                              function(x) x + means))

averagecoords <- t(( rep(0, 87) %*% t(as.matrix(eigenvec))) + t(means))

Now we’ll estimate the euclidean distances between landmarks.

eucdist <- as.data.frame(matrix(0, ncol = ncol(vectors), nrow = nrow(means)/3))
colnames(eucdist) <- colnames(vectors)

for(col in 1:ncol(eucdist)){
  eucdist[, col] <- getDistance(fsdcoords[, col], fsdcoords[, col + 18])
}

#On the same scale
eucdist       <- eucdist %>% tibble::rowid_to_column() %>% gather(var, value, -rowid)
eucdist$value <- scales::rescale(eucdist$value)
eucdist       <- spread(eucdist, var,  value)
eucdist$rowid <- NULL
PlotMultipleFaces(averagecoords, facets, eucdist[,c(13:18)])
PlotMultipleFaces(averagecoords, facets, eucdist[,c(7:12)])
PlotMultipleFaces(averagecoords, facets, eucdist[,c(1:6)])